home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / pascal / tvtool2.zip / TVMENUS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-20  |  5KB  |  50 lines
  1. {*
  2. *
  3. *   Copyright (c) 1992,93 by Richard W. Hansen
  4. *
  5. *   This source code will compile.
  6. *   Full source code available to registered users.
  7. *
  8. *}
  9. (* This file was mangled by Mangler 1.10 (c) Copyright 1993 by Berend de Boer *)
  10.  UNIT TVMENUS ;{$B+} {$X+} {$V-} {$I TVDEFS.INC} INTERFACE USES TVCONST , APP , DRIVERS , MENUS , VIEWS , OBJECTS ;
  11. CONST CHECKMARK :STRING [ 10 ] ='√';CHECKMARKNULL :STRING [ 10 ] =' ';CHECKMARKLEN :BYTE =1 ;
  12. TYPE PBXMENUBAR =^TBXMENUBAR ;TBXMENUBAR =OBJECT (TMENUBAR)PROCEDURE CLEARMARKER (CMD :WORD );FUNCTION FINDCMD
  13. (AMENU :PMENU ;CMD :WORD ):PMENUITEM ;PROCEDURE HANDLEEVENT (VAR E :TEVENT );VIRTUAL;FUNCTION MARKERISSET
  14. (CMD :WORD ):BOOLEAN ;PROCEDURE RESETMARKERS (FIRSTCMD :WORD ;LASTCMD :WORD ;NEWCMD :WORD );PROCEDURE SETMARKER
  15. (CMD :WORD );PROCEDURE TOGGLEMARKER (CMD :WORD );END ;FUNCTION NEWMARKEDITEM (NAME ,PARAM:TMENUSTR ;KEYCODE :WORD ;
  16. COMMAND :WORD ;AHELPCTX :WORD ;NEXT :PMENUITEM ):PMENUITEM ;FUNCTION POPUPMENU (POPMENU :PMENUBOX ):WORD ;
  17. FUNCTION MOUSEPOPUPMENU (POPMENU :PMENUBOX ):WORD ;PROCEDURE REGISTERTVMENUS ;
  18. CONST RBXMENUBAR :TSTREAMREC =(OBJTYPE :5250 ;VMTLINK :OFS (TYPEOF (TBXMENUBAR )^);LOAD :@ TBXMENUBAR . LOAD ;STORE :@
  19. TBXMENUBAR . STORE );IMPLEMENTATION FUNCTION POPUPMENU (POPMENU:PMENUBOX):WORD ;VAR OlIlOOOl0:WORD;OIOO0l010lO:TEVENT;
  20. OOIO:INTEGER;OOIl:INTEGER;BEGIN OOIO := POPMENU ^. ORIGIN.X ;IF (OOIO + POPMENU ^. SIZE.X )> DESKTOP ^. SIZE.X THEN OOIO
  21. := DESKTOP ^. SIZE.X - POPMENU ^. SIZE.X ;OOIl := POPMENU ^. ORIGIN.Y ;IF (OOIl + POPMENU ^. SIZE.Y )> DESKTOP ^. SIZE.Y
  22. THEN OOIl := DESKTOP ^. SIZE.Y - POPMENU ^. SIZE.Y ;IF (OOIO < 0 )THEN OOIO := 0 ;IF (OOIl < 0 )THEN OOIl := 0 ;POPMENU
  23. ^. MOVETO (OOIO , OOIl );POPUPMENU := DESKTOP ^. EXECVIEW (POPMENU );END ;FUNCTION MOUSEPOPUPMENU (POPMENU:PMENUBOX):WORD
  24. ;VAR OlIlOOOl0:WORD;OIOO0l010lO:TEVENT;OIOllI0O1OI:TPOINT;BEGIN REPEAT DESKTOP ^. GETEVENT (OIOO0l010lO );UNTIL
  25. (OIOO0l010lO.WHAT =EVMOUSEUP );DESKTOP ^. MAKELOCAL (MOUSEWHERE , OIOllI0O1OI );IF (OIOllI0O1OI.X + POPMENU ^. SIZE.X )>
  26. DESKTOP ^. SIZE.X THEN OIOllI0O1OI.X := DESKTOP ^. SIZE.X - POPMENU ^. SIZE.X ;IF (OIOllI0O1OI.Y + POPMENU ^. SIZE.Y )>
  27. DESKTOP ^. SIZE.Y THEN OIOllI0O1OI.Y := DESKTOP ^. SIZE.Y - POPMENU ^. SIZE.Y ;IF (OIOllI0O1OI.X < 0 )THEN OIOllI0O1OI.X
  28. := 0 ;IF (OIOllI0O1OI.Y < 0 )THEN OIOllI0O1OI.Y := 0 ;POPMENU ^. MOVETO (OIOllI0O1OI.X , OIOllI0O1OI.Y );MOUSEPOPUPMENU
  29. := DESKTOP ^. EXECVIEW (POPMENU );END ;FUNCTION NEWMARKEDITEM (NAME,PARAM:TMENUSTR;KEYCODE:WORD;COMMAND:WORD;
  30. AHELPCTX:WORD;NEXT:PMENUITEM):PMENUITEM ;VAR OIlO:BYTE;BEGIN IF (COPY (NAME , 1 , CHECKMARKLEN )<> CHECKMARK )THEN INSERT
  31. (CHECKMARKNULL , NAME , 1 );IF (NAME [ CHECKMARKLEN + 1 ] <> ' ')THEN INSERT (' ', NAME , CHECKMARKLEN + 1 );
  32. NEWMARKEDITEM := NEWITEM (NAME , PARAM , KEYCODE , COMMAND , AHELPCTX , NEXT );END ;PROCEDURE TBXMENUBAR.HANDLEEVENT
  33. (VAR E:TEVENT);BEGIN IF (E.WHAT =EVCOMMAND )THEN IF (E.COMMAND >= CMMARKSTART )AND (E.COMMAND <= CMMARKEND )THEN
  34. BEGIN TOGGLEMARKER (E.COMMAND );END ;INHERITED HANDLEEVENT(E );END ;PROCEDURE TBXMENUBAR.TOGGLEMARKER (CMD:WORD);
  35. BEGIN IF MARKERISSET (CMD )THEN CLEARMARKER (CMD )ELSE SETMARKER (CMD );END ;PROCEDURE TBXMENUBAR.SETMARKER (CMD:WORD);
  36. VAR OO10:PMENUITEM;OIlO:BYTE;BEGIN OO10 := FINDCMD (MENU , CMD );IF (OO10 <> NIL )THEN FOR OIlO := 1 TO CHECKMARKLEN
  37.  DO OO10 ^. NAME ^[ OIlO ] := CHECKMARK [ OIlO ] ;END ;PROCEDURE TBXMENUBAR.CLEARMARKER (CMD:WORD);VAR OO10:PMENUITEM;
  38. OIlO:BYTE;BEGIN OO10 := FINDCMD (MENU , CMD );IF (OO10 <> NIL )THEN FOR OIlO := 1 TO CHECKMARKLEN  DO OO10 ^. NAME ^[
  39. OIlO ] := CHECKMARKNULL [ OIlO ] ;END ;FUNCTION TBXMENUBAR.MARKERISSET (CMD:WORD):BOOLEAN ;VAR OO10:PMENUITEM;
  40. BEGIN MARKERISSET := FALSE ;OO10 := FINDCMD (MENU , CMD );IF (OO10 <> NIL )THEN MARKERISSET := (COPY (OO10 ^. NAME ^, 1 ,
  41. CHECKMARKLEN )=CHECKMARK );END ;PROCEDURE TBXMENUBAR.RESETMARKERS (FIRSTCMD:WORD;LASTCMD:WORD;NEWCMD:WORD);
  42. VAR OO10:PMENUITEM;OIlO:BYTE;BEGIN OO10 := FINDCMD (MENU , FIRSTCMD );WHILE (OO10 <> NIL ) DO BEGIN IF (OO10 ^. COMMAND
  43. =NEWCMD )THEN FOR OIlO := 1 TO CHECKMARKLEN  DO OO10 ^. NAME ^[ OIlO ] := CHECKMARK [ OIlO ] ELSE IF (OO10 ^. COMMAND >=
  44. FIRSTCMD )AND (OO10 ^. COMMAND <= LASTCMD )THEN FOR OIlO := 1 TO CHECKMARKLEN  DO OO10 ^. NAME ^[ OIlO ] := CHECKMARKNULL
  45. [ OIlO ] ;OO10 := OO10 ^. NEXT ;END ;END ;FUNCTION TBXMENUBAR.FINDCMD (AMENU:PMENU;CMD:WORD):PMENUITEM ;
  46. VAR OO10:PMENUITEM;OI1000l1II00:PMENUITEM;BEGIN OI1000l1II00 := NIL ;OO10 := AMENU ^. ITEMS ;WHILE (OO10 <> NIL )AND
  47. (OI1000l1II00 =NIL ) DO BEGIN IF (OO10 ^. COMMAND =0 )AND (OO10 ^. NAME <> NIL )THEN OI1000l1II00 := FINDCMD (OO10 ^.
  48. SUBMENU , CMD )ELSE IF (OO10 ^. COMMAND =CMD )AND NOT OO10 ^. DISABLED THEN OI1000l1II00 := OO10 ;OO10 := OO10 ^. NEXT ;
  49. END ;FINDCMD := OI1000l1II00 ;END ;PROCEDURE REGISTERTVMENUS ;BEGIN REGISTERTYPE (RBXMENUBAR );END ;END .
  50.